home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / sswitch.exe / SSSWITCH.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-08-21  |  7.2 KB  |  223 lines
  1. Program SSswitch;
  2.  
  3. (****************************************************************)
  4. (*                                                              *)
  5. (*     Screen Saver Switch                                      *)
  6. (*     Minimized app that allows temporary turning off of       *)
  7. (*     Windows 3.1 Screen Saver.                                *)
  8. (*                                                              *)
  9. (*        8/20/92   Peter Franchuk     Rochester,NY             *)
  10. (*                  [76476,1414]                                *)
  11. (****************************************************************)
  12.  
  13. uses winprocs,wintypes,Wobjects,win31;
  14.  
  15. {$R ssswitch.res}
  16.  
  17. const
  18.   cm_Switof  = 100;
  19.   cm_Switon  = 101;
  20.   cm_About   = 102;
  21.   cm_Top     = 103;
  22.   cm_BNow    = 104;
  23.   cmw_Switof = 200;
  24.   cmw_Switon = 201;
  25.   cmw_About  = 202;
  26.   cmw_Top    = 203;
  27.   cmw_Bnow   = 204;
  28.  
  29.  
  30. type
  31.  
  32.   { Define a TApplication descendant } 
  33.   TNoSavr = object(TApplication)
  34.     procedure InitMainWindow; virtual;
  35.   end;
  36.  
  37.   { Define Main window iconic}
  38.  
  39.   PMainWnd=^TMainWnd;
  40.   TMainWnd=Object(TWindow)
  41.     Foundit,Doit,topper:Bool;
  42.     itson,itsoff:hIcon;
  43.     constructor init;
  44.     procedure SetupWindow;virtual;
  45.     function GetClassName:PChar; virtual;
  46.     procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  47.     destructor Done;Virtual;
  48.     procedure WMSyscommand(var Msg:TMessage);
  49.       virtual wm_First + wm_Syscommand;
  50.     procedure WMQueryOpen(var Msg:TMessage);
  51.       virtual wm_First + wm_QueryOpen;
  52.     procedure CMSwitof(var msg:TMessage);
  53.       virtual cm_First + cm_Switof;
  54.     procedure CMSwiton(var msg:TMessage);
  55.       virtual cm_First + cm_Switon;
  56.     procedure CMAbout(var msg:TMessage);
  57.       virtual cm_First +cm_About;
  58.     procedure CMTop(var msg:TMessage);
  59.       virtual cm_First + cm_Top;
  60.     procedure CMBNow(var msg:TMessage);
  61.       virtual cm_First + cm_BNow;
  62.     procedure ShutDown;
  63.   end;
  64.  
  65.  
  66. constructor TMainWnd.init;
  67.   begin
  68.     TWindow.init(nil,'ScrnSave');       {Get the curren state of Screen Saver}
  69.     SystemParametersInfo(SPI_GetScreenSaveActive,0,@Foundit,0);
  70.     Doit := foundit;
  71.     topper := true;
  72.   end;
  73.  
  74. procedure TMainWnd.SetupWindow;
  75.   var
  76.     SysMenu : hMenu;
  77.   begin
  78.     TWindow.SetupWindow;              {Expand the System menu}
  79.     SysMenu := GetSystemMenu(hWindow,false);
  80.     DeleteMenu(SysMenu,sc_Restore,mf_ByCommand);
  81.     DeleteMenu(SysMenu,sc_Size,mf_ByCommand);
  82.     DeleteMenu(SysMenu,sc_Minimize,mf_ByCommand);
  83.     DeleteMenu(SysMenu,sc_Maximize,mf_ByCommand);
  84.     AppendMenu(SysMenu,mf_Separator,0,nil);
  85.     AppendMenu(SysMenu,mf_Grayed,cmw_Switon,'Enable');
  86.     AppendMenu(SysMenu,mf_Enabled,cmw_Switof,'Disable');
  87.     AppendMenu(SysMenu,mf_Separator,0,nil);
  88.     AppendMenu(SysMenu,mf_Enabled,cmw_About,'About');
  89.     AppendMenu(SysMenu,mf_Separator,0,nil);
  90.     AppendMenu(SysMenu,mf_Enabled,cmw_BNow,'Blank Now');
  91.     AppendMenu(SysMenu,mf_Enabled,cmw_Top,'Always on top');
  92.     CheckMenuItem(SysMenu,cmw_Top,mf_byCommand or mf_Checked);
  93.  
  94.    { We Initialize with the Icon Always on top}
  95.     SetWindowPos(hWindow,HWND_TOPMOST,0,0,0,0,SWP_NoMove or SWP_NoSize);
  96.  
  97.    { We start with the Screen saver enabled}
  98.     SystemParametersInfo(SPI_SetScreenSaveActive,Word(Doit),nil,0);
  99.    { If it wasn't on we bail out}
  100.     if not Foundit then shutdown;
  101.   end;
  102.     
  103. function TMainWnd.GetClassName:PChar;
  104.   begin GetClassName := 'ScrStop' end;
  105.  
  106. procedure TMainWnd.GetWindowClass(var AWndClass:TwndClass);
  107.   begin
  108.     Twindow.GetWindowClass(AWndClass);
  109.     itson := LoadIcon(hInstance,'SSon');
  110.     itsoff := LoadIcon(hInstance,'SSoff');  {Get our two Icons}
  111.     AWndClass.hIcon := itson;
  112.   end;
  113.  
  114. procedure TMainWnd.ShutDown;
  115.   const
  116.     BadMsg='You MUST have Screen Blanker ON. '+#13+'Use Desktop under Control Program. ';
  117.   begin
  118.     MessageBeep(mb_IconStop);
  119.     MessageBox(hWindow,BadMsg,'Aborting',mb_Ok or mb_IconStop);
  120.     PostQuitMessage(0);
  121.   end;
  122.  
  123. destructor TMainWnd.Done;
  124.   begin                                { Restore Screen Saver to how we found it}
  125.     SystemParametersInfo(SPI_SetScreenSaveActive,Word(Foundit),nil,0);
  126.     TWindow.Done;
  127.   end;
  128.  
  129.  
  130. procedure TMainWnd.WMSyscommand(var Msg:TMessage);
  131.   begin
  132.     case msg.wparam of                       { Handle our new system menu cmds}
  133.      cmw_About:     SendMessage(hWindow,wm_Command,cm_About,0);
  134.      cmw_Switon:    SendMessage(hWindow,wm_Command,cm_Switon,0);
  135.      cmw_Switof:    SendMessage(hWindow,wm_Command,cm_Switof,0);
  136.     { cmw_BNow:      SendMessage(hWindow,wm_Command,cm_BNow,0);} {don't know how yet}
  137.      cmw_Top:       SendMessage(hWIndow,wm_Command,cm_Top,0);
  138.      else DefWndProc(msg);
  139.      end;
  140.   end;
  141.  
  142. procedure TMainWnd.WMQueryOpen(var Msg:TMessage);
  143.   begin
  144.     msg.result :=0;                          { Keep the window as an Icon}
  145.   end;
  146.  
  147. procedure TMainWnd.CMSwiton(var MSG:TMessage);
  148.   var
  149.     SysMenu : hMenu;                         { Turn Screen save on}
  150.   begin                                          { Adjust menu and icon}
  151.     SysMenu := GetSystemMenu(hWindow,false);
  152.     SetClassWord(HWindow,gcw_HIcon,itson);
  153.     EnableMenuItem(SysMenu,cmw_Switon,mf_byCommand or mf_Grayed);
  154.     EnableMenuItem(SysMenu,cmw_Switof,mf_byCommand or mf_Enabled);
  155.     Doit := true;
  156.     SystemParametersInfo(SPI_SetScreenSaveActive,Word(Doit),nil,0);
  157.     InvalidateRect(hWindow,nil,true);
  158.   end;
  159.  
  160. procedure TMainWnd.CMSwitof(var MSG:TMessage);
  161.   var
  162.     SysMenu : hMenu;                         { Turn Screen Save off}
  163.   begin                                          { Adjust menu and icon}
  164.     SysMenu := GetSystemMenu(hWindow,false);
  165.     SetClassWord(HWindow,gcw_HIcon,itsoff);
  166.     EnableMenuItem(SysMenu,cmw_Switof,mf_byCommand or mf_Grayed);
  167.     EnableMenuItem(SysMenu,cmw_Switon,mf_byCommand or mf_Enabled);
  168.     Doit := false;
  169.     SystemParametersInfo(SPI_SetScreenSaveActive,word(Doit),nil,0);
  170.     InvalidateRect(hWindow,nil,true);
  171.   end;
  172.  
  173. procedure TMainWnd.CMAbout(var msg:Tmessage);
  174.   var D:PDialog;
  175.   begin                                     { VERY short info}
  176.     d := New(Pdialog,init(@self,'ABOUT'));
  177.     application^.execdialog(d);
  178.   end;
  179.  
  180. procedure TMainWnd.CMBNow(var msg:TMessage);
  181.   var
  182.     HoldTime:word;                          { Blank it now}
  183.   begin
  184.     MessageBeep(mb_IconAsterisk);
  185.     MessageBox(hWindow,'Not Yet Implemented','Sorry',mb_ok or mb_IconAsterisk);
  186.     CMSwiton(msg);
  187.   end;
  188.  
  189. procedure TMainWnd.CMTop(var msg:TMessage);
  190.   var
  191.     SysMenu : hMenu;                       { Stay on top or not toggle}
  192.   begin
  193.     SysMenu := GetSystemMenu(hWindow,false);
  194.     topper := not topper;
  195.     if topper=true
  196.      then begin
  197.       CheckMenuItem(SysMenu,cmw_Top,mf_byCommand or mf_Checked);
  198.       SetWindowPos(hWindow,HWND_TOPMOST,0,0,0,0,SWP_NoMove or SWP_NoSize);
  199.      end else
  200.      begin
  201.       CheckMenuItem(SysMenu,cmw_Top,mf_byCommand or mf_UnChecked);
  202.       SetWindowPos(hWindow,HWND_NOTOPMOST,0,0,0,0,SWP_NoMove or SWP_NoSize);
  203.      end
  204.   end;
  205.  
  206. { Construct the App's MainWindow object }
  207. procedure TNoSavr.InitMainWindow;
  208. begin
  209.   MainWindow := New(PMainWnd, Init);
  210. end;
  211.  
  212. var
  213.   HApp:TNoSavr;
  214.  
  215. BEGIN
  216.  
  217.   CmdShow := sw_ShowMinimized;     {start out iconic}
  218.  
  219.   HApp.Init('HelloApp');
  220.   HApp.Run;
  221.   HApp.Done;
  222. END.
  223.